Delphi Programmer's Power Pack/Delphi Volume 1.iso/s_to_z/spidr100/setup.arv/HASHTEST.PAS

Pascal/Delphi Source File | 1996-09-15 | 6.2 KB | 253 lines

{----------------------------------------------------------------------------
|
| Library: Spider Containers for Object Pascal
|
| Module: HastTest.Pas
|
| Description: Form to test hash and string table classes.
|              Since a TStringTable uses a THashTable for implementation,
|              a TStringTable instance is used as the container for this
|              test form.
|
| History: Version 1.0  March 1996. Copyright (c) 1996 Michel Brazeau
|                                   Interval Software
|
|---------------------------------------------------------------------------}
unit HashTest;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls,

  StrTable;  { TStringTable }

type
  THashTableForm = class(TForm)
    ListBox: TListBox;
    ItemCount: TLabel;
    AddButton: TButton;
    SearchButton: TButton;
    DeleteButton: TButton;
    ClearButton: TButton;
    LoadButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClearButtonClick(Sender: TObject);
    procedure SearchButtonClick(Sender: TObject);
    procedure LoadButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
  private
    StringTable : TStringTable;

    { redraws the list box, from the contents of the hash table }
    procedure UpdateListBox;

    { iterator method to add a TStringCombo to the list box }
    procedure AddString(const Obj : TObject);

  public

    { Public declarations }
  end;

implementation

{$R *.DFM}

uses
      ObjTest,    { TestForm }
      ObjList,    { TUnorderedList }
      ObjBuckt;   { TStringCombo }

const
    { Hash table size (number of unique hash entries in table }
    CHashTableSize = 500;

{--------------------------------------------------------------------------}

procedure THashTableForm.FormCreate(Sender: TObject);
begin
    StringTable := TStringTable.Create(CHashTableSize);
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.FormDestroy(Sender: TObject);
begin
    StringTable.Free;
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.UpdateListBox;
begin
    ListBox.Clear;

    Screen.Cursor := crHourGlass;

    ListBox.Enabled := False;

    try

        StringTable.ForEachCallMethod(AddString);

    finally

        ListBox.Enabled := True;
        Screen.Cursor := crDefault;

    end;

    ItemCount.Caption := IntToStr(StringTable.Size);
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.AddString(const Obj : TObject);
begin
    ListBox.Items.Add((Obj as TStringCombo).Str);
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.AddButtonClick(Sender: TObject);
const
    Str : String = '';
begin
    if not InputQuery('', 'String to add: ', Str) then
        Exit;

    StringTable.Insert(Str, nil);

    UpdateListBox;
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.FormClose( Sender: TObject;
                                    var Action: TCloseAction);
begin
    Action := caFree;
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.ClearButtonClick(Sender: TObject);
begin
    StringTable.Clear;

    UpdateListBox;
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.SearchButtonClick(Sender: TObject);
const
    Str       : String   = '';
    OccurStr  : String   = '1';

var
    Occur     : LongInt;

begin
    if not InputQuery('', 'Search for : ', Str) then
        Exit;

    if not InputQuery('', 'Occurence : ', OccurStr) then
        Exit;

    Occur := StrtoInt(OccurStr);

    if StringTable.Search(Str, Occur) <> nil then
        MessageDlg('String found', mtInformation,[mbOk], 0)
    else
        MessageDlg('String NOT found!', mtInformation,[mbOk], 0);
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.LoadButtonClick(Sender: TObject);
var
    StringList   : TUnorderedList;

    Str          : String;

    I            : LongInt;

begin
    StringList := TUnOrderedList.Create(TStringCombo, CompareStringCombo);
    try
        ListBox.Enabled := False;

        TestForm.LoadStringsFromFile(StringList);

        Screen.Cursor := crHourGlass;

        try
            I := 1;

            { insert all the values in StringList }
            if StringList.GotoFirst then
            repeat
                { give other applications processing time }
                if (I mod 500) = 0 then
                    Application.ProcessMessages;
                Inc(I);

                Str := (StringList.CurrentObj as TStringCombo).Str;

                StringTable.Insert(Str, nil);

           until not StringList.GotoNext;

        finally
            Screen.Cursor := crDefault;

            ListBox.Enabled := True;
        end;

    finally
        StringList.Free;

        ListBox.ItemIndex := ListBox.Items.Count - 1;

        UpdateListBox;
    end;
end;

{--------------------------------------------------------------------------}

procedure THashTableForm.DeleteButtonClick(Sender: TObject);
const
    Str       : String  = '';
    OccurStr  : String  = '1';

var
    Occur     : LongInt;

begin
    if not InputQuery('', 'String to delete : ', Str) then
        Exit;

    if not InputQuery('', 'Occurence : ', OccurStr) then
        Exit;

    Occur := StrtoInt(OccurStr);

    if StringTable.Delete(Str, Occur) then
    begin
        MessageDlg('String deleted', mtInformation,[mbOk], 0);
        UpdateListBox;
    end
    else
        MessageDlg('String NOT found!', mtInformation,[mbOk], 0);
end;

{--------------------------------------------------------------------------}

end.